home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 27 / CU Amiga Magazine's Super CD-ROM 27 (1998)(EMAP Images)(GB)[!][issue 1998-10].iso / CUCD / Programming / JForth / Extras / SysGen / SELECT < prev    next >
Encoding:
Text File  |  1988-09-05  |  793 b   |  32 lines
  1.  
  2. ( SELECT --- positional case statement )
  3. FALSE 
  4. .IF  
  5. CODE <SELECT>   ( N1 --- )  ( IP --R-- [IP+1]+N1*CELL )
  6.     SP A@+ 0DR DN MOVE  2 # 0DR DN ASL
  7.     IP 0DR CELL AN+R+B  W  AN MOVE
  8.     W     A@+  TEMP0 AN  MOVE
  9.     IP A@ IP AN MOVE
  10.     TEMP0 A@  JMP    END-CODE
  11.  
  12. .THEN 
  13.  
  14. : <SELECT>  ( N1 --- )  ( IP --R-- IP' )
  15.     1+ CELLS
  16.     INLINE@       ( -- bytes adr0 )
  17.     DUP @ INLINE+ ( -- bytes adr0 )
  18.     tuck + @      ( -- adr0 offset )  + EXECUTE ;
  19.  
  20. : SELECT  ( --- )  ?COMP  COMPILE <SELECT>  HERE 0 ,  
  21.     BEGIN       BL WORD DUP $" END-SELECT" $= 
  22.     WHILE-NOT   FIND  NOT ABORT" SELECT item not found!"  over - , 
  23.     REPEAT      DROP  DUP HERE - ABS SWAP !  
  24. ;  IMMEDIATE
  25.  
  26. ( SELECT WORD1 WORD2 ... END-SELECT )
  27.  
  28. : END-SELECT ; 
  29.  
  30. ( NEW VERSION TESTED SEPT/13/86.  BTD.  SEEMS FINE )
  31.  
  32.